todo: manifeste rs aus rels berechnen

Load data

load("../gocd2/data/cleaned.rdata")

library(tidyverse)
## Warning: package 'ggplot2' was built under R version 4.3.1
## Warning: package 'lubridate' was built under R version 4.3.1
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.4     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(labelled)

saveRDS(s2_initial, file = "s2_initial.rds")
s2_initial %>% names()
##   [1] "session"                           "created"                          
##   [3] "modified"                          "ended"                            
##   [5] "expired"                           "bfi_open_1"                       
##   [7] "narq_5"                            "narq_3"                           
##   [9] "bfi_agree_2"                       "pvd_infectability_1"              
##  [11] "bfi_consc_2r"                      "soi_r_attitude_6r"                
##  [13] "asendorpf_shyness_4r"              "bfi_neuro_2r"                     
##  [15] "bfi_open_2"                        "bfi_extra_1"                      
##  [17] "bfi_extra_3"                       "bfi_agree_3r"                     
##  [19] "soi_r_attitude_4"                  "narq_15"                          
##  [21] "bfi_consc_3"                       "soi_r_attitude_5"                 
##  [23] "narq_2"                            "asendorpf_shyness_2"              
##  [25] "bfi_agree_1r"                      "bfi_consc_1"                      
##  [27] "narq_11"                           "bfi_neuro_1"                      
##  [29] "bfi_extra_2r"                      "bfi_neuro_3"                      
##  [31] "narq_18"                           "bfi_open_3"                       
##  [33] "asendorpf_shyness_5"               "bfi_extra_4"                      
##  [35] "narq_16"                           "bfi_agree_4"                      
##  [37] "bfi_consc_9r"                      "bfi_neuro_4"                      
##  [39] "bfi_open_4"                        "bfi_extra_5r"                     
##  [41] "bfi_agree_5"                       "narq_1"                           
##  [43] "bfi_consc_4r"                      "bfi_neuro_5r"                     
##  [45] "bfi_open_5"                        "bfi_extra_6"                      
##  [47] "narq_14"                           "bfi_agree_6r"                     
##  [49] "bfi_consc_5"                       "asendorpf_shyness_3r"             
##  [51] "pvd_germ_aversion_2"               "pvd_germ_aversion_3R"             
##  [53] "bfi_neuro_8"                       "pvd_infectability_3R"             
##  [55] "pvd_germ_aversion_1"               "feel_safe_walking_dark"           
##  [57] "feel_safe_violent_crime"           "feel_safe_sexual_assault"         
##  [59] "feel_safe_theft"                   "bfi_open_6"                       
##  [61] "narq_17"                           "bfi_extra_7r"                     
##  [63] "bfi_agree_7"                       "narq_4"                           
##  [65] "asendorpf_shyness_1"               "bfi_consc_6"                      
##  [67] "bfi_neuro_6r"                      "bfi_open_7r"                      
##  [69] "narq_13"                           "bfi_extra_8"                      
##  [71] "bfi_agree_8r"                      "narq_6"                           
##  [73] "bfi_consc_7"                       "bfi_neuro_7"                      
##  [75] "narq_7"                            "bfi_open_8"                       
##  [77] "narq_12"                           "bfi_open_9r"                      
##  [79] "bfi_agree_9"                       "narq_8"                           
##  [81] "bfi_consc_8r"                      "narq_9"                           
##  [83] "narq_10"                           "bfi_open_10"                      
##  [85] "pvd_infectability_2"               "pvd_germ_aversion_4R"             
##  [87] "spms_partner_1"                    "spms_partner_2"                   
##  [89] "spms_partner_3R"                   "satisfaction_sexual_intercourse"  
##  [91] "satisfaction_single_life"          "investment_potential_partner"     
##  [93] "timeperiod_potential_partner"      "characteristics_potential_partner"
##  [95] "quantity_potential_partner"        "sexual_partner"                   
##  [97] "fling_frequency"                   "fling_frequency_2"                
##  [99] "relationship_importance"           "relationship_importance_partner"  
## [101] "partner_attractiveness_longterm"   "partner_attractiveness_shortterm" 
## [103] "partner_attractiveness_face"       "partner_attractiveness_body"      
## [105] "attractiveness_warmth"             "partner_attractiveness_trust"     
## [107] "net_income_partner"                "partner_sexiness"                 
## [109] "partner_strength"                  "partner_feel_safe"                
## [111] "spms_self_1"                       "spms_self_2"                      
## [113] "spms_self_3R"                      "meet_potential_partner"           
## [115] "partner_height"                    "meet_potential_partner_other"     
## [117] "partner_weight"                    "soi_r_behavior_1"                 
## [119] "soi_r_behavior_2"                  "soi_r_behavior_3"                 
## [121] "soi_r_desire_9"                    "soi_r_desire_7"                   
## [123] "soi_r_desire_8"                    "relationship_problems"            
## [125] "relationship_satisfaction_overall" "relationship_conflict"            
## [127] "relationship_satisfaction_2"       "relationship_satisfaction_3"      
## [129] "alternatives_1"                    "alternatives_2"                   
## [131] "alternatives_3"                    "alternatives_4"                   
## [133] "alternatives_5"                    "alternatives_6"                   
## [135] "investment_1"                      "investment_2"                     
## [137] "investment_3"                      "commitment_1"                     
## [139] "commitment_2"                      "commitment_3"                     
## [141] "communal_strength_1"               "communal_strength_2R"             
## [143] "communal_strength_3"               "communal_strength_4"              
## [145] "sexual_communal_strength_1"        "sexual_communal_strength_2"       
## [147] "sexual_communal_strength_3"        "ecr_avo_1R"                       
## [149] "ecr_anx_1"                         "ecr_avo_2"                        
## [151] "ecr_anx_2"                         "ecr_anx_3"                        
## [153] "ecr_avo_3R"                        "ecr_avo_4"                        
## [155] "ecr_anx_4R"                        "ecr_avo_5R"                       
## [157] "ecr_anx_5"                         "ecr_avo_6"                        
## [159] "ecr_anx_6"                         "free_not_covered"                 
## [161] "narq"                              "bfi_open"                         
## [163] "bfi_extra"                         "bfi_agree"                        
## [165] "soi_r_attitude"                    "bfi_consc"                        
## [167] "asendorpf_shyness"                 "bfi_neuro"                        
## [169] "pvd_germ_aversion"                 "pvd_infectability"                
## [171] "spms_partner"                      "spms_self"                        
## [173] "relationship_satisfaction"         "alternatives"                     
## [175] "investment"                        "commitment"                       
## [177] "communal_strength"                 "sexual_communal_strength"         
## [179] "ecr_avo"                           "ecr_anx"                          
## [181] "short"                             "soi_r_desire"                     
## [183] "soi_r_behavior_1_discrete"         "soi_r_behavior_2_discrete"        
## [185] "soi_r_behavior_3_discrete"         "soi_r_behavior"                   
## [187] "soi_r"                             "spms_rel"                         
## [189] "partner_attractiveness_sexual"     "relationship_conflict_R"          
## [191] "relationship_problems_R"
scales <- s2_initial %>% select(narq:ecr_anx) %>% map(attributes)
likert_items <- s2_initial %>% select(bfi_open_1, narq_5, narq_3, bfi_agree_2, pvd_infectability_1, bfi_consc_2r, soi_r_attitude_6r, asendorpf_shyness_4r, bfi_neuro_2r, bfi_open_2, bfi_extra_1, bfi_extra_3, bfi_agree_3r, soi_r_attitude_4, narq_15, bfi_consc_3, soi_r_attitude_5, narq_2, asendorpf_shyness_2, bfi_agree_1r, bfi_consc_1, narq_11, bfi_neuro_1, bfi_extra_2r, bfi_neuro_3, narq_18, bfi_open_3, asendorpf_shyness_5, bfi_extra_4, narq_16, bfi_agree_4, bfi_consc_9r, bfi_neuro_4, bfi_open_4, bfi_extra_5r, bfi_agree_5, narq_1, bfi_consc_4r, bfi_neuro_5r, bfi_open_5, bfi_extra_6, narq_14, bfi_agree_6r, bfi_consc_5, asendorpf_shyness_3r, pvd_germ_aversion_2, pvd_germ_aversion_3R, bfi_neuro_8, pvd_infectability_3R, pvd_germ_aversion_1, feel_safe_walking_dark, feel_safe_violent_crime, feel_safe_sexual_assault, feel_safe_theft, bfi_open_6, narq_17, bfi_extra_7r, bfi_agree_7, narq_4, asendorpf_shyness_1, bfi_consc_6, bfi_neuro_6r, bfi_open_7r, narq_13, bfi_extra_8, bfi_agree_8r, narq_6, bfi_consc_7, bfi_neuro_7, narq_7, bfi_open_8, narq_12, bfi_open_9r, bfi_agree_9, narq_8, bfi_consc_8r, narq_9, narq_10, bfi_open_10, pvd_infectability_2, pvd_germ_aversion_4R, spms_partner_1, spms_partner_2, spms_partner_3R, satisfaction_sexual_intercourse, satisfaction_single_life, investment_potential_partner, quantity_potential_partner, relationship_importance, relationship_importance_partner, partner_attractiveness_longterm, partner_attractiveness_shortterm, partner_attractiveness_face, partner_attractiveness_body, attractiveness_warmth, partner_attractiveness_trust, partner_sexiness, partner_strength, partner_feel_safe, spms_self_1, spms_self_2, spms_self_3R, soi_r_desire_9, soi_r_desire_7, soi_r_desire_8, relationship_problems, relationship_satisfaction_overall, relationship_conflict, relationship_satisfaction_2, relationship_satisfaction_3, alternatives_1, alternatives_2, alternatives_3, alternatives_4, alternatives_5, alternatives_6, investment_1, investment_2, investment_3, commitment_1, commitment_2, commitment_3, communal_strength_1, communal_strength_2R, communal_strength_3, communal_strength_4, sexual_communal_strength_1, sexual_communal_strength_2, sexual_communal_strength_3, ecr_avo_1R, ecr_anx_1, ecr_avo_2, ecr_anx_2, ecr_anx_3, ecr_avo_3R, ecr_avo_4, ecr_anx_4R, ecr_avo_5R, ecr_anx_5, ecr_avo_6, ecr_anx_6)


item_table <- rio::import("https://docs.google.com/spreadsheets/d/1apYY4LZO05plk8jr-EVQUQfLWW2fgBfMrX2ntmPEMdc/edit#gid=483254913", format = "xlsx")

var_label(likert_items$soi_r_desire_8) <- "Wie oft empfinden Sie sexuelle Erregung im Kontakt mit Personen, mit denen Sie zur Zeit keine feste Beziehung führen?"

var_label(likert_items$commitment_2) <- "Ich orientiere mich an einer langfristigen Zukunft unserer Partnerschaft (z.B. stelle mir unser Zusammensein in einigen Jahren vor, mache Pläne für die Zukunft)."

var_label(likert_items$narq_1) <- "Ich bin großartig."

library(codebook)
## 
## Attaching package: 'codebook'
## 
## The following object is masked from 'package:labelled':
## 
##     to_factor
likert_items <- likert_items %>% 
    mutate_at(vars(matches("\\d[rR]$")), reverse_labelled_values)

correlations <- likert_items %>% cor(use = 'p') %>% 
  as.data.frame() %>% 
  as_tibble(rownames = "item") %>% 
  pivot_longer(-item) %>% 
  rename(item_1 = item, item_2 = name, correlation = value) %>% 
  filter(correlation != 1, !is.na(correlation))

correlations %>% 
  rio::export("item_correlations.csv")

correlations %>% select(-correlation) %>% 
  rio::export("possible_item_pairs.csv")

likert_items_with_labels <- 
  likert_items %>% var_label() %>% 
  enframe("item_name", "label") %>% 
  unnest(label) %>% 
  left_join(item_table %>% select(label, label_en, showif), by = c("label" = "label"))

likert_items_with_labels %>% 
  rio::export("gocd2_item_labels.csv")

Test

llm0710 <- rio::import("ruben-test-item-similarity-20230710-164559.csv")
llm1018 <- rio::import("ruben-test-item-similarity-20231018-122504.csv")
llm0809 <- rio::import("ruben-test-ItemSimilarityTraining-20230809-trial106.csv")

names(llm0710) <- c("row", "item_1_label", "item_2_label", "similarity_0710")
names(llm1018) <- c("row", "item_1_label", "item_2_label", "similarity_1018")
names(llm0809) <- c("row", "item_1_label", "item_2_label", "similarity_0809")

llm0710 <- llm0710 %>% 
  mutate(
    item_1_label = str_replace_all(item_1_label, '""', '"'),
    item_2_label = str_replace_all(item_2_label, '""', '"')
  )

llm1018 <- llm1018 %>% 
  mutate(
    item_1_label = str_replace_all(item_1_label, '""', '"'),
    item_2_label = str_replace_all(item_2_label, '""', '"')
  )

llm0809 <- llm0809 %>% 
  mutate(
    item_1_label = str_replace_all(item_1_label, '""', '"'),
    item_2_label = str_replace_all(item_2_label, '""', '"')
  )

# correlations %>% 
#   full_join(likert_items_with_labels %>% 
#               select(item_name, item_1_label = label_en), 
#             by = c("item_1" = "item_name")) %>% 
#   anti_join(llm0710, by = c("item_1_label")) %>% 
#   select(item_1_label) %>% 
#   View()

correlations_llm <- correlations %>% 
  full_join(likert_items_with_labels %>% 
              select(item_name, item_1_label = label_en), 
            by = c("item_1" = "item_name")) %>% 
  full_join(likert_items_with_labels %>% 
              select(item_name, item_2_label = label_en), 
            by = c("item_2" = "item_name")) %>% 
  full_join(llm0710, by = c("item_1_label", "item_2_label")) %>% 
  full_join(llm1018, by = c("item_1_label", "item_2_label")) %>% 
  full_join(llm0809, by = c("item_1_label", "item_2_label"))

correlations_llm %>% drop_na() %>% nrow()
## [1] 9717
correlations_llm %>% 
  select(correlation, similarity_0710, similarity_1018, similarity_0809) %>% 
  cor(use = 'p')
##                 correlation similarity_0710 similarity_1018 similarity_0809
## correlation       1.0000000       0.5714303       0.5869598       0.6014052
## similarity_0710   0.5714303       1.0000000       0.8182191       0.8719794
## similarity_1018   0.5869598       0.8182191       1.0000000       0.8580867
## similarity_0809   0.6014052       0.8719794       0.8580867       1.0000000
correlations_llm %>% 
  filter(!str_detect(item_1, "^bfi_"), !str_detect(item_2, "^bfi_")) %>% 
  filter(!str_detect(item_1, "^narq"), !str_detect(item_2, "^narq_")) %>% 
  filter(!str_detect(item_1, "^asendorpf"), !str_detect(item_2, "^asendorpf")) %>% 
  select(correlation, similarity_0710, similarity_1018, similarity_0809) %>% 
  cor(use = 'p')
##                 correlation similarity_0710 similarity_1018 similarity_0809
## correlation       1.0000000       0.5192127       0.5035130       0.5421965
## similarity_0710   0.5192127       1.0000000       0.7842760       0.8324001
## similarity_1018   0.5035130       0.7842760       1.0000000       0.8599076
## similarity_0809   0.5421965       0.8324001       0.8599076       1.0000000
correlations_llm %>% 
  select(correlation, similarity_0710, similarity_1018, similarity_0809) %>% 
  mutate_all(abs) %>% 
  cor(use = 'p')
##                 correlation similarity_0710 similarity_1018 similarity_0809
## correlation       1.0000000       0.4765112       0.4745521       0.4885470
## similarity_0710   0.4765112       1.0000000       0.7061711       0.7973930
## similarity_1018   0.4745521       0.7061711       1.0000000       0.7547388
## similarity_0809   0.4885470       0.7973930       0.7547388       1.0000000
ggplot(correlations_llm, aes(correlation, similarity_0710)) +
  geom_point(alpha = 0.05)
## Warning: Removed 10616 rows containing missing values (`geom_point()`).

ggplot(correlations_llm, aes(correlation, similarity_1018)) +
  geom_point(alpha = 0.2)
## Warning: Removed 10616 rows containing missing values (`geom_point()`).

ggplot(correlations_llm, aes(correlation, similarity_0809)) +
  geom_point(alpha = 0.2)
## Warning: Removed 10616 rows containing missing values (`geom_point()`).

library(plotly) 
## Warning: package 'plotly' was built under R version 4.3.1
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
correlations_llm %>% 
  # filter(str_detect(item_1, "bfi_agree"), str_detect(item_2, "bfi_agree")) %>% 
  mutate(correlation = round(correlation, 2)) %>% 
  mutate(similarity_0710 = round(similarity_0710, 2)) %>% 
  mutate(items = str_c(item_1_label, "\n", item_2_label)) %>% 
ggplot(., aes(correlation, similarity_0710, label = items)) + 
  geom_point() -> p

ggplotly(p)
correlations_llm %>% 
  mutate(correlation = round(correlation, 2)) %>% 
  mutate(similarity_1018 = round(similarity_1018, 2)) %>% 
  mutate(items = str_c(item_1_label, "\n", item_2_label)) %>% 
ggplot(., aes(correlation, similarity_1018, label = items)) + 
  geom_point() -> p

ggplotly(p)
correlations_llm %>% 
  mutate(correlation = round(correlation, 2)) %>% 
  mutate(similarity_0809 = round(similarity_0809, 2)) %>% 
  mutate(items = str_c(item_1_label, "\n", item_2_label)) %>% 
ggplot(., aes(correlation, similarity_0809, label = items)) + 
  geom_point() -> p

ggplotly(p)

Scale level

library(lavaan)
## This is lavaan 0.6-16
## lavaan is FREE software! Please report any bugs.
library(corrr)
tibble <- likert_items %>% cor(use = 'p') %>% as_cordf() %>% 
  shave() %>%
  stretch() %>% 
  drop_na()

empirical_cors <- tibble %>% as.data.frame() |> 
  igraph::graph_from_data_frame(directed = FALSE) |> 
  igraph::as_adjacency_matrix(attr = "r", sparse = FALSE)
diag(empirical_cors) <- 1

# empirical_cors2 <- likert_items %>% cor(use = 'p')
# empirical_cors %>% as_cordf() %>% stretch() %>% left_join(empirical_cors2 %>% as_cordf() %>% stretch(), by = c("x", "y")) %>% filter(round(r.x,2) != round(r.y, 2))


empirical_cors[str_detect(rownames(empirical_cors), "\\d[rR]$"), ] <- 
  empirical_cors[str_detect(rownames(empirical_cors), "\\d[rR]$"), ] * -1
empirical_cors[, str_detect(colnames(empirical_cors), "\\d[rR]$")] <- 
  empirical_cors[, str_detect(colnames(empirical_cors), "\\d[rR]$")] * -1
empirical_cors["bfi_agree_3r", "bfi_agree_1r"]
## [1] 0.3932222
empirical_cors["bfi_agree_2", "bfi_agree_1r"]
## [1] 0.174473
#> This is lavaan 0.6-14
#> lavaan is FREE software! Please report any bugs.
lcor <- cfa("bfi_neuro =~ bfi_neuro_2r + bfi_neuro_1 + bfi_neuro_3 + bfi_neuro_4 + bfi_neuro_5r + bfi_neuro_8 + bfi_neuro_6r + bfi_neuro_7
            spms_self =~ spms_self_1 + spms_self_2 + spms_self_3R", 
            sample.cov = empirical_cors, sample.nobs = 1000)
summary(lcor, standardized = T, ci=T)
## lavaan 0.6.16 ended normally after 23 iterations
## 
##   Estimator                                         ML
##   Optimization method                           NLMINB
##   Number of model parameters                        23
## 
##   Number of observations                          1000
## 
## Model Test User Model:
##                                                       
##   Test statistic                               366.819
##   Degrees of freedom                                43
##   P-value (Chi-square)                           0.000
## 
## Parameter Estimates:
## 
##   Standard errors                             Standard
##   Information                                 Expected
##   Information saturated (h1) model          Structured
## 
## Latent Variables:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##   bfi_neuro =~                                                          
##     bfi_neuro_2r      1.000                               1.000    1.000
##     bfi_neuro_1       0.729    0.047   15.467    0.000    0.637    0.822
##     bfi_neuro_3       0.950    0.047   20.041    0.000    0.857    1.043
##     bfi_neuro_4       0.774    0.047   16.413    0.000    0.682    0.867
##     bfi_neuro_5r      0.988    0.048   20.806    0.000    0.895    1.081
##     bfi_neuro_8       0.789    0.047   16.708    0.000    0.696    0.881
##     bfi_neuro_6r      0.998    0.048   20.995    0.000    0.905    1.091
##     bfi_neuro_7       0.847    0.047   17.918    0.000    0.754    0.939
##   spms_self =~                                                          
##     spms_self_1       1.000                               1.000    1.000
##     spms_self_2       1.069    0.040   26.959    0.000    0.991    1.147
##     spms_self_3R      0.912    0.037   24.703    0.000    0.839    0.984
##    Std.lv  Std.all
##                   
##     0.725    0.725
##     0.529    0.529
##     0.689    0.689
##     0.562    0.562
##     0.717    0.717
##     0.572    0.572
##     0.724    0.724
##     0.614    0.614
##                   
##     0.821    0.821
##     0.878    0.878
##     0.748    0.749
## 
## Covariances:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##   bfi_neuro ~~                                                          
##     spms_self        -0.109    0.022   -4.860    0.000   -0.153   -0.065
##    Std.lv  Std.all
##                   
##    -0.183   -0.183
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##    .bfi_neuro_2r      0.473    0.026   18.260    0.000    0.423    0.524
##    .bfi_neuro_1       0.719    0.034   20.938    0.000    0.652    0.787
##    .bfi_neuro_3       0.524    0.028   19.026    0.000    0.470    0.578
##    .bfi_neuro_4       0.684    0.033   20.671    0.000    0.619    0.749
##    .bfi_neuro_5r      0.485    0.026   18.456    0.000    0.434    0.537
##    .bfi_neuro_8       0.672    0.033   20.579    0.000    0.608    0.736
##    .bfi_neuro_6r      0.475    0.026   18.295    0.000    0.425    0.526
##    .bfi_neuro_7       0.622    0.031   20.137    0.000    0.562    0.683
##    .spms_self_1       0.325    0.023   13.890    0.000    0.279    0.371
##    .spms_self_2       0.229    0.023    9.825    0.000    0.183    0.274
##    .spms_self_3R      0.439    0.025   17.635    0.000    0.390    0.488
##     bfi_neuro         0.526    0.042   12.488    0.000    0.443    0.608
##     spms_self         0.674    0.046   14.634    0.000    0.584    0.764
##    Std.lv  Std.all
##     0.473    0.474
##     0.719    0.720
##     0.524    0.525
##     0.684    0.684
##     0.485    0.486
##     0.672    0.673
##     0.475    0.476
##     0.622    0.623
##     0.325    0.325
##     0.229    0.229
##     0.439    0.439
##     1.000    1.000
##     1.000    1.000
semTools::compRelSEM(lcor)
## bfi_neuro spms_self 
##     0.844     0.858
tibble <- llm1018 %>% 
  full_join(likert_items_with_labels %>% 
              select(item_name_1 = item_name, item_1_label = label_en)) %>% 
  full_join(likert_items_with_labels %>% 
              select(item_name_2 = item_name, item_2_label = label_en)) %>% 
  select(x = item_name_1, y = item_name_2, r = similarity_1018) %>% 
  drop_na()
## Joining with `by = join_by(item_1_label)`
## Joining with `by = join_by(item_2_label)`
cors <- tibble %>% as.data.frame() |> 
  igraph::graph_from_data_frame(directed = FALSE) |> 
  igraph::as_adjacency_matrix(attr = "r", sparse = FALSE)
diag(cors) <- 1


# library(corrr)
# cors <- retract(tibble) %>% as_cordf() %>% shave(upper = F) %>% 
#   as_matrix()
# cors[lower.tri(cors)] <- t(cors)[lower.tri(cors)]
# diag(cors) <- 1

cors[str_detect(rownames(cors), "\\d[rR]$"), ] <- 
  cors[str_detect(rownames(cors), "\\d[rR]$"), ] * -1
cors[, str_detect(colnames(cors), "\\d[rR]$")] <- 
  cors[, str_detect(colnames(cors), "\\d[rR]$")] * -1
cors["bfi_agree_3r", "bfi_agree_1r"]
## [1] 0.7062705
cors["bfi_agree_2", "bfi_agree_3r"]
## [1] 0.02743899
cors["bfi_agree_2", "bfi_agree_1r"]
## [1] 0.03940754
library(semTools)
##  
## ###############################################################################
## This is semTools 0.5-6
## All users of R (or SEM) are invited to submit functions or ideas for functions.
## ###############################################################################
## 
## Attaching package: 'semTools'
## 
## The following object is masked from 'package:readr':
## 
##     clipboard
lcor <- cfa("bfi_neuro =~ bfi_neuro_2r + bfi_neuro_1 + bfi_neuro_3 + bfi_neuro_4 +  + bfi_neuro_8 + bfi_neuro_6r + bfi_neuro_7
            spms_self =~ spms_self_1 + spms_self_2 + spms_self_3R", 
            sample.cov = cors, sample.nobs = 1000)
semTools::compRelSEM(lcor)
## bfi_neuro spms_self 
##     0.734     0.679
summary(lcor, standardized = T, ci=T)
## lavaan 0.6.16 ended normally after 76 iterations
## 
##   Estimator                                         ML
##   Optimization method                           NLMINB
##   Number of model parameters                        21
## 
##   Number of observations                          1000
## 
## Model Test User Model:
##                                                       
##   Test statistic                               659.252
##   Degrees of freedom                                34
##   P-value (Chi-square)                           0.000
## 
## Parameter Estimates:
## 
##   Standard errors                             Standard
##   Information                                 Expected
##   Information saturated (h1) model          Structured
## 
## Latent Variables:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##   bfi_neuro =~                                                          
##     bfi_neuro_2r      1.000                               1.000    1.000
##     bfi_neuro_1       3.887    1.049    3.704    0.000    1.830    5.943
##     bfi_neuro_3       6.322    1.673    3.778    0.000    3.043    9.602
##     bfi_neuro_4       5.136    1.368    3.756    0.000    2.456    7.816
##     bfi_neuro_8       5.852    1.552    3.771    0.000    2.811    8.893
##     bfi_neuro_6r      1.931    0.570    3.388    0.001    0.814    3.048
##     bfi_neuro_7       5.938    1.574    3.773    0.000    2.853    9.022
##   spms_self =~                                                          
##     spms_self_1       1.000                               1.000    1.000
##     spms_self_2       0.720    0.112    6.422    0.000    0.500    0.940
##     spms_self_3R      0.234    0.047    4.961    0.000    0.142    0.327
##    Std.lv  Std.all
##                   
##     0.129    0.129
##     0.501    0.501
##     0.814    0.815
##     0.661    0.662
##     0.754    0.754
##     0.249    0.249
##     0.765    0.765
##                   
##     0.943    0.944
##     0.679    0.680
##     0.221    0.221
## 
## Covariances:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##   bfi_neuro ~~                                                          
##     spms_self         0.009    0.005    1.771    0.077   -0.001    0.018
##    Std.lv  Std.all
##                   
##     0.072    0.072
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|) ci.lower ci.upper
##    .bfi_neuro_2r      0.982    0.044   22.297    0.000    0.896    1.069
##    .bfi_neuro_1       0.748    0.036   21.079    0.000    0.679    0.818
##    .bfi_neuro_3       0.336    0.023   14.539    0.000    0.291    0.381
##    .bfi_neuro_4       0.561    0.029   19.331    0.000    0.505    0.618
##    .bfi_neuro_8       0.431    0.025   17.137    0.000    0.382    0.480
##    .bfi_neuro_6r      0.937    0.042   22.110    0.000    0.854    1.020
##    .bfi_neuro_7       0.414    0.025   16.749    0.000    0.366    0.463
##    .spms_self_1       0.110    0.135    0.811    0.418   -0.155    0.375
##    .spms_self_2       0.538    0.074    7.251    0.000    0.392    0.683
##    .spms_self_3R      0.950    0.043   22.017    0.000    0.866    1.035
##     bfi_neuro         0.017    0.009    1.892    0.058   -0.001    0.034
##     spms_self         0.889    0.142    6.251    0.000    0.611    1.168
##    Std.lv  Std.all
##     0.982    0.983
##     0.748    0.749
##     0.336    0.336
##     0.561    0.562
##     0.431    0.431
##     0.937    0.938
##     0.414    0.415
##     0.110    0.110
##     0.538    0.538
##     0.950    0.951
##     1.000    1.000
##     1.000    1.000
scales$relationship_satisfaction <- NULL
for(i in seq_along(scales)) {
  scale <- names(scales)[i]
  items <- scales[[i]]$scale_item_names
  scales[[i]]$lvn <- paste(scale, " =~ ", paste(items, collapse = " + "))
}
model <- scales %>% map(~ .$lvn) %>% paste(collapse = "\n")

lcor_real <- cfa(model, 
            sample.cov = empirical_cors, sample.nobs = 1000)
rels_real <- semTools::compRelSEM(lcor_real)
summary(lcor_real)
## lavaan 0.6.16 ended normally after 271 iterations
## 
##   Estimator                                         ML
##   Optimization method                           NLMINB
##   Number of model parameters                       399
## 
##   Number of observations                          1000
## 
## Model Test User Model:
##                                                        
##   Test statistic                              19232.807
##   Degrees of freedom                               6156
##   P-value (Chi-square)                            0.000
## 
## Parameter Estimates:
## 
##   Standard errors                             Standard
##   Information                                 Expected
##   Information saturated (h1) model          Structured
## 
## Latent Variables:
##                               Estimate  Std.Err  z-value  P(>|z|)
##   narq =~                                                        
##     narq_5                       1.000                           
##     narq_3                       1.260    0.109   11.531    0.000
##     narq_15                      1.235    0.108   11.415    0.000
##     narq_2                       1.126    0.104   10.866    0.000
##     narq_11                      0.534    0.084    6.361    0.000
##     narq_18                      0.767    0.090    8.480    0.000
##     narq_16                      1.400    0.116   12.117    0.000
##     narq_1                       1.046    0.100   10.415    0.000
##     narq_14                      0.539    0.084    6.413    0.000
##     narq_17                      1.018    0.099   10.252    0.000
##     narq_4                       1.169    0.105   11.089    0.000
##     narq_13                      0.877    0.094    9.317    0.000
##     narq_6                       1.080    0.102   10.611    0.000
##     narq_7                       1.192    0.106   11.209    0.000
##     narq_12                      1.131    0.104   10.894    0.000
##     narq_8                       1.396    0.115   12.099    0.000
##     narq_9                       1.105    0.103   10.750    0.000
##     narq_10                      1.171    0.106   11.103    0.000
##   bfi_open =~                                                    
##     bfi_open_1                   1.000                           
##     bfi_open_2                   0.668    0.049   13.654    0.000
##     bfi_open_3                   0.566    0.049   11.621    0.000
##     bfi_open_4                   0.898    0.050   18.112    0.000
##     bfi_open_5                   1.062    0.050   21.056    0.000
##     bfi_open_6                   0.781    0.049   15.874    0.000
##     bfi_open_7r                  0.419    0.049    8.635    0.000
##     bfi_open_8                   0.891    0.050   17.989    0.000
##     bfi_open_9r                  0.804    0.049   16.312    0.000
##     bfi_open_10                  0.660    0.049   13.494    0.000
##   bfi_extra =~                                                   
##     bfi_extra_1                  1.000                           
##     bfi_extra_3                  0.708    0.043   16.290    0.000
##     bfi_extra_2r                 1.078    0.042   25.460    0.000
##     bfi_extra_4                  0.782    0.043   18.054    0.000
##     bfi_extra_5r                 1.045    0.042   24.623    0.000
##     bfi_extra_6                  0.635    0.044   14.541    0.000
##     bfi_extra_7r                 0.984    0.043   23.068    0.000
##     bfi_extra_8                  1.133    0.042   26.883    0.000
##   bfi_agree =~                                                   
##     bfi_agree_2                  1.000                           
##     bfi_agree_3r                 1.043    0.109    9.580    0.000
##     bfi_agree_1r                 1.285    0.120   10.682    0.000
##     bfi_agree_4                  1.041    0.109    9.568    0.000
##     bfi_agree_5                  1.053    0.109    9.630    0.000
##     bfi_agree_6r                 1.629    0.139   11.760    0.000
##     bfi_agree_7                  1.080    0.111    9.771    0.000
##     bfi_agree_8r                 1.800    0.149   12.119    0.000
##     bfi_agree_9                  0.962    0.105    9.126    0.000
##   soi_r_attitude =~                                              
##     soi_r_atttd_6r               1.000                           
##     soi_r_attitd_4               0.962    0.038   25.652    0.000
##     soi_r_attitd_5               1.000    0.038   26.467    0.000
##   bfi_consc =~                                                   
##     bfi_consc_2r                 1.000                           
##     bfi_consc_3                  1.483    0.128   11.628    0.000
##     bfi_consc_1                  1.555    0.131   11.843    0.000
##     bfi_consc_9r                 1.260    0.116   10.819    0.000
##     bfi_consc_4r                 1.407    0.124   11.378    0.000
##     bfi_consc_5                  1.465    0.127   11.570    0.000
##     bfi_consc_6                  1.428    0.125   11.451    0.000
##     bfi_consc_7                  1.367    0.122   11.236    0.000
##     bfi_consc_8r                 1.334    0.120   11.115    0.000
##   asendorpf_shyness =~                                           
##     asndrpf_shyn_4               1.000                           
##     asndrpf_shyn_2               0.937    0.037   25.007    0.000
##     asndrpf_shyn_5               0.715    0.039   18.192    0.000
##     asndrpf_shyn_3               1.032    0.037   28.270    0.000
##     asndrpf_shyn_1               1.033    0.037   28.299    0.000
##   bfi_neuro =~                                                   
##     bfi_neuro_2r                 1.000                           
##     bfi_neuro_1                  0.825    0.051   16.310    0.000
##     bfi_neuro_3                  1.027    0.052   19.931    0.000
##     bfi_neuro_4                  0.834    0.051   16.484    0.000
##     bfi_neuro_5r                 0.996    0.051   19.402    0.000
##     bfi_neuro_8                  0.863    0.051   17.005    0.000
##     bfi_neuro_6r                 0.997    0.051   19.408    0.000
##     bfi_neuro_7                  0.922    0.051   18.091    0.000
##   pvd_germ_aversion =~                                           
##     pvd_grm_vrsn_2               1.000                           
##     pvd_grm_vrs_3R               0.944    0.088   10.775    0.000
##     pvd_grm_vrsn_1               0.999    0.091   11.030    0.000
##     pvd_grm_vrs_4R               0.656    0.077    8.523    0.000
##   pvd_infectability =~                                           
##     pvd_nfctblty_1               1.000                           
##     pvd_nfctblt_3R               0.889    0.037   23.776    0.000
##     pvd_nfctblty_2               0.894    0.037   23.879    0.000
##   spms_partner =~                                                
##     spms_partner_1               1.000                           
##     spms_partner_2               1.088    0.047   23.328    0.000
##     spms_partnr_3R               0.875    0.042   20.994    0.000
##   spms_self =~                                                   
##     spms_self_1                  1.000                           
##     spms_self_2                  1.057    0.036   29.071    0.000
##     spms_self_3R                 0.909    0.036   25.304    0.000
##   alternatives =~                                                
##     alternatives_1               1.000                           
##     alternatives_2               0.881    0.048   18.273    0.000
##     alternatives_3               0.725    0.048   15.138    0.000
##     alternatives_4               0.776    0.048   16.180    0.000
##     alternatives_5               0.856    0.048   17.772    0.000
##     alternatives_6               0.631    0.048   13.215    0.000
##   investment =~                                                  
##     investment_1                 1.000                           
##     investment_2                 0.855    0.066   12.869    0.000
##     investment_3                 0.529    0.057    9.261    0.000
##   commitment =~                                                  
##     commitment_1                 1.000                           
##     commitment_2                 0.943    0.032   29.920    0.000
##     commitment_3                 0.918    0.032   28.847    0.000
##   communal_strength =~                                           
##     cmmnl_strngt_1               1.000                           
##     cmmnl_strng_2R               0.749    0.046   16.168    0.000
##     cmmnl_strngt_3               0.859    0.047   18.440    0.000
##     cmmnl_strngt_4               0.651    0.046   14.078    0.000
##   sexual_communal_strength =~                                    
##     sxl_cmmnl_st_1               1.000                           
##     sxl_cmmnl_st_2               1.131    0.053   21.397    0.000
##     sxl_cmmnl_st_3               0.520    0.044   11.726    0.000
##   ecr_avo =~                                                     
##     ecr_avo_1R                   1.000                           
##     ecr_avo_2                    0.470    0.043   10.804    0.000
##     ecr_avo_3R                   1.023    0.042   24.428    0.000
##     ecr_avo_4                    0.624    0.043   14.493    0.000
##     ecr_avo_5R                   1.029    0.042   24.583    0.000
##     ecr_avo_6                    0.491    0.043   11.297    0.000
##   ecr_anx =~                                                     
##     ecr_anx_1                    1.000                           
##     ecr_anx_2                    5.040    1.051    4.797    0.000
##     ecr_anx_3                    5.557    1.158    4.798    0.000
##     ecr_anx_4R                   1.867    0.435    4.294    0.000
##     ecr_anx_5                    1.201    0.322    3.725    0.000
##     ecr_anx_6                    3.607    0.765    4.712    0.000
## 
## Covariances:
##                               Estimate  Std.Err  z-value  P(>|z|)
##   narq ~~                                                        
##     bfi_open                     0.096    0.014    6.822    0.000
##     bfi_extra                    0.093    0.014    6.680    0.000
##     bfi_agree                   -0.065    0.010   -6.575    0.000
##     soi_r_attitude               0.031    0.014    2.297    0.022
##     bfi_consc                    0.002    0.007    0.236    0.813
##     asndrpf_shynss              -0.074    0.014   -5.326    0.000
##     bfi_neuro                    0.014    0.011    1.270    0.204
##     pvd_germ_avrsn               0.047    0.012    3.942    0.000
##     pvd_infectblty               0.002    0.014    0.134    0.894
##     spms_partner                 0.013    0.013    0.972    0.331
##     spms_self                    0.139    0.017    8.069    0.000
##     alternatives                 0.103    0.015    6.874    0.000
##     investment                   0.009    0.013    0.675    0.500
##     commitment                  -0.012    0.014   -0.851    0.395
##     commnl_strngth              -0.015    0.013   -1.161    0.246
##     sxl_cmmnl_strn              -0.001    0.013   -0.093    0.926
##     ecr_avo                     -0.008    0.013   -0.660    0.509
##     ecr_anx                      0.004    0.003    1.570    0.116
##   bfi_open ~~                                                    
##     bfi_extra                    0.113    0.020    5.652    0.000
##     bfi_agree                    0.022    0.012    1.926    0.054
##     soi_r_attitude               0.047    0.022    2.163    0.031
##     bfi_consc                    0.033    0.012    2.794    0.005
##     asndrpf_shynss              -0.096    0.021   -4.540    0.000
##     bfi_neuro                   -0.044    0.018   -2.417    0.016
##     pvd_germ_avrsn              -0.038    0.018   -2.118    0.034
##     pvd_infectblty               0.020    0.023    0.858    0.391
##     spms_partner                 0.103    0.022    4.771    0.000
##     spms_self                    0.158    0.023    6.860    0.000
##     alternatives                 0.069    0.020    3.382    0.001
##     investment                  -0.019    0.022   -0.869    0.385
##     commitment                  -0.029    0.023   -1.276    0.202
##     commnl_strngth               0.020    0.021    0.924    0.355
##     sxl_cmmnl_strn              -0.012    0.021   -0.570    0.569
##     ecr_avo                      0.002    0.020    0.095    0.924
##     ecr_anx                     -0.004    0.004   -0.926    0.354
##   bfi_extra ~~                                                   
##     bfi_agree                    0.088    0.014    6.398    0.000
##     soi_r_attitude               0.108    0.022    4.814    0.000
##     bfi_consc                    0.065    0.013    5.091    0.000
##     asndrpf_shynss              -0.551    0.034  -16.395    0.000
##     bfi_neuro                   -0.190    0.021   -9.029    0.000
##     pvd_germ_avrsn              -0.088    0.019   -4.635    0.000
##     pvd_infectblty              -0.053    0.023   -2.316    0.021
##     spms_partner                 0.066    0.021    3.089    0.002
##     spms_self                    0.184    0.023    7.841    0.000
##     alternatives                 0.074    0.021    3.577    0.000
##     investment                  -0.049    0.022   -2.224    0.026
##     commitment                   0.021    0.023    0.914    0.361
##     commnl_strngth               0.042    0.022    1.954    0.051
##     sxl_cmmnl_strn               0.071    0.021    3.350    0.001
##     ecr_avo                     -0.049    0.021   -2.375    0.018
##     ecr_anx                     -0.006    0.004   -1.272    0.203
##   bfi_agree ~~                                                   
##     soi_r_attitude              -0.025    0.013   -1.858    0.063
##     bfi_consc                    0.036    0.008    4.512    0.000
##     asndrpf_shynss              -0.106    0.015   -6.922    0.000
##     bfi_neuro                   -0.122    0.015   -7.963    0.000
##     pvd_germ_avrsn              -0.095    0.014   -6.692    0.000
##     pvd_infectblty              -0.031    0.014   -2.184    0.029
##     spms_partner                -0.003    0.013   -0.268    0.789
##     spms_self                    0.011    0.013    0.818    0.413
##     alternatives                -0.021    0.012   -1.663    0.096
##     investment                   0.011    0.013    0.866    0.386
##     commitment                   0.026    0.014    1.875    0.061
##     commnl_strngth               0.067    0.014    4.710    0.000
##     sxl_cmmnl_strn               0.034    0.013    2.607    0.009
##     ecr_avo                     -0.045    0.013   -3.426    0.001
##     ecr_anx                     -0.004    0.003   -1.412    0.158
##   soi_r_attitude ~~                                              
##     bfi_consc                   -0.057    0.014   -4.090    0.000
##     asndrpf_shynss              -0.136    0.024   -5.591    0.000
##     bfi_neuro                   -0.050    0.021   -2.381    0.017
##     pvd_germ_avrsn              -0.115    0.022   -5.233    0.000
##     pvd_infectblty              -0.017    0.026   -0.662    0.508
##     spms_partner                 0.058    0.024    2.379    0.017
##     spms_self                    0.147    0.026    5.714    0.000
##     alternatives                 0.302    0.027   11.111    0.000
##     investment                  -0.175    0.026   -6.641    0.000
##     commitment                  -0.156    0.027   -5.824    0.000
##     commnl_strngth              -0.140    0.025   -5.492    0.000
##     sxl_cmmnl_strn              -0.082    0.024   -3.414    0.001
##     ecr_avo                      0.065    0.024    2.751    0.006
##     ecr_anx                      0.008    0.005    1.614    0.106
##   bfi_consc ~~                                                   
##     asndrpf_shynss              -0.075    0.014   -5.417    0.000
##     bfi_neuro                   -0.088    0.013   -6.583    0.000
##     pvd_germ_avrsn               0.013    0.011    1.148    0.251
##     pvd_infectblty              -0.023    0.014   -1.692    0.091
##     spms_partner                 0.020    0.013    1.580    0.114
##     spms_self                    0.045    0.014    3.333    0.001
##     alternatives                -0.042    0.013   -3.316    0.001
##     investment                   0.016    0.013    1.185    0.236
##     commitment                   0.029    0.014    2.095    0.036
##     commnl_strngth               0.052    0.014    3.808    0.000
##     sxl_cmmnl_strn               0.035    0.013    2.729    0.006
##     ecr_avo                     -0.033    0.013   -2.596    0.009
##     ecr_anx                     -0.013    0.004   -3.336    0.001
##   asendorpf_shyness ~~                                           
##     bfi_neuro                    0.258    0.024   10.809    0.000
##     pvd_germ_avrsn               0.079    0.020    3.893    0.000
##     pvd_infectblty               0.082    0.025    3.283    0.001
##     spms_partner                -0.068    0.023   -2.943    0.003
##     spms_self                   -0.232    0.026   -9.039    0.000
##     alternatives                -0.069    0.022   -3.138    0.002
##     investment                   0.074    0.024    3.105    0.002
##     commitment                  -0.026    0.025   -1.055    0.291
##     commnl_strngth              -0.040    0.023   -1.691    0.091
##     sxl_cmmnl_strn              -0.081    0.023   -3.565    0.000
##     ecr_avo                      0.036    0.022    1.633    0.102
##     ecr_anx                      0.006    0.005    1.247    0.213
##   bfi_neuro ~~                                                   
##     pvd_germ_avrsn               0.115    0.019    5.997    0.000
##     pvd_infectblty               0.202    0.024    8.376    0.000
##     spms_partner                -0.024    0.020   -1.205    0.228
##     spms_self                   -0.106    0.022   -4.901    0.000
##     alternatives                -0.030    0.020   -1.553    0.120
##     investment                   0.097    0.022    4.468    0.000
##     commitment                  -0.009    0.022   -0.389    0.697
##     commnl_strngth              -0.051    0.021   -2.444    0.015
##     sxl_cmmnl_strn              -0.031    0.020   -1.543    0.123
##     ecr_avo                      0.028    0.020    1.404    0.160
##     ecr_anx                      0.023    0.006    3.600    0.000
##   pvd_germ_aversion ~~                                           
##     pvd_infectblty               0.091    0.022    4.055    0.000
##     spms_partner                 0.016    0.020    0.795    0.427
##     spms_self                    0.019    0.021    0.920    0.357
##     alternatives                -0.040    0.019   -2.066    0.039
##     investment                   0.039    0.021    1.887    0.059
##     commitment                   0.006    0.022    0.286    0.775
##     commnl_strngth               0.003    0.020    0.165    0.869
##     sxl_cmmnl_strn               0.006    0.020    0.329    0.742
##     ecr_avo                      0.042    0.020    2.157    0.031
##     ecr_anx                      0.008    0.004    1.791    0.073
##   pvd_infectability ~~                                           
##     spms_partner                -0.014    0.025   -0.550    0.582
##     spms_self                   -0.025    0.026   -0.966    0.334
##     alternatives                -0.030    0.024   -1.222    0.222
##     investment                   0.049    0.026    1.882    0.060
##     commitment                   0.051    0.027    1.875    0.061
##     commnl_strngth              -0.009    0.026   -0.357    0.721
##     sxl_cmmnl_strn              -0.023    0.025   -0.920    0.358
##     ecr_avo                     -0.019    0.025   -0.789    0.430
##     ecr_anx                      0.004    0.005    0.744    0.457
##   spms_partner ~~                                                
##     spms_self                    0.198    0.026    7.699    0.000
##     alternatives                -0.015    0.022   -0.651    0.515
##     investment                  -0.012    0.024   -0.479    0.632
##     commitment                   0.059    0.025    2.336    0.019
##     commnl_strngth               0.081    0.024    3.336    0.001
##     sxl_cmmnl_strn               0.110    0.024    4.642    0.000
##     ecr_avo                     -0.006    0.023   -0.249    0.803
##     ecr_anx                      0.008    0.005    1.579    0.114
##   spms_self ~~                                                   
##     alternatives                 0.249    0.026    9.622    0.000
##     investment                  -0.060    0.025   -2.405    0.016
##     commitment                  -0.016    0.026   -0.634    0.526
##     commnl_strngth               0.031    0.025    1.247    0.212
##     sxl_cmmnl_strn               0.038    0.024    1.590    0.112
##     ecr_avo                     -0.006    0.023   -0.272    0.786
##     ecr_anx                     -0.004    0.005   -0.821    0.411
##   alternatives ~~                                                
##     investment                  -0.149    0.024   -6.098    0.000
##     commitment                  -0.366    0.029  -12.519    0.000
##     commnl_strngth              -0.234    0.026   -9.170    0.000
##     sxl_cmmnl_strn              -0.171    0.024   -7.189    0.000
##     ecr_avo                      0.237    0.025    9.579    0.000
##     ecr_anx                      0.017    0.006    2.954    0.003
##   investment ~~                                                  
##     commitment                   0.329    0.030   10.889    0.000
##     commnl_strngth               0.208    0.027    7.777    0.000
##     sxl_cmmnl_strn               0.107    0.024    4.375    0.000
##     ecr_avo                     -0.257    0.027   -9.557    0.000
##     ecr_anx                      0.005    0.005    1.081    0.280
##   commitment ~~                                                  
##     commnl_strngth               0.407    0.031   13.127    0.000
##     sxl_cmmnl_strn               0.219    0.027    8.158    0.000
##     ecr_avo                     -0.463    0.032  -14.587    0.000
##     ecr_anx                     -0.020    0.007   -3.069    0.002
##   communal_strength ~~                                           
##     sxl_cmmnl_strn               0.405    0.031   12.988    0.000
##     ecr_avo                     -0.317    0.028  -11.482    0.000
##     ecr_anx                     -0.009    0.005   -1.697    0.090
##   sexual_communal_strength ~~                                    
##     ecr_avo                     -0.172    0.024   -7.154    0.000
##     ecr_anx                      0.002    0.005    0.434    0.665
##   ecr_avo ~~                                                     
##     ecr_anx                      0.030    0.008    3.862    0.000
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##    .narq_5            0.805    0.037   21.506    0.000
##    .narq_3            0.691    0.033   20.777    0.000
##    .narq_15           0.703    0.034   20.866    0.000
##    .narq_2            0.753    0.036   21.202    0.000
##    .narq_11           0.944    0.043   22.153    0.000
##    .narq_18           0.885    0.040   21.904    0.000
##    .narq_16           0.619    0.031   20.176    0.000
##    .narq_1            0.787    0.037   21.405    0.000
##    .narq_14           0.943    0.043   22.149    0.000
##    .narq_17           0.798    0.037   21.466    0.000
##    .narq_4            0.734    0.035   21.080    0.000
##    .narq_13           0.850    0.039   21.738    0.000
##    .narq_6            0.773    0.036   21.323    0.000
##    .narq_7            0.723    0.034   21.007    0.000
##    .narq_12           0.751    0.035   21.188    0.000
##    .narq_8            0.621    0.031   20.199    0.000
##    .narq_9            0.762    0.036   21.259    0.000
##    .narq_10           0.733    0.035   21.072    0.000
##    .bfi_open_1        0.495    0.027   18.298    0.000
##    .bfi_open_2        0.774    0.036   21.213    0.000
##    .bfi_open_3        0.837    0.039   21.599    0.000
##    .bfi_open_4        0.593    0.030   19.637    0.000
##    .bfi_open_5        0.430    0.025   17.088    0.000
##    .bfi_open_6        0.692    0.034   20.601    0.000
##    .bfi_open_7r       0.911    0.041   21.978    0.000
##    .bfi_open_8        0.599    0.030   19.704    0.000
##    .bfi_open_9r       0.674    0.033   20.447    0.000
##    .bfi_open_10       0.779    0.037   21.248    0.000
##    .bfi_extra_1       0.454    0.022   20.321    0.000
##    .bfi_extra_3       0.725    0.033   21.726    0.000
##    .bfi_extra_2r      0.365    0.019   19.396    0.000
##    .bfi_extra_4       0.666    0.031   21.518    0.000
##    .bfi_extra_5r      0.403    0.020   19.842    0.000
##    .bfi_extra_6       0.779    0.036   21.887    0.000
##    .bfi_extra_7r      0.471    0.023   20.457    0.000
##    .bfi_extra_8       0.299    0.016   18.327    0.000
##    .bfi_agree_2       0.822    0.039   21.331    0.000
##    .bfi_agree_3r      0.806    0.038   21.217    0.000
##    .bfi_agree_1r      0.707    0.035   20.371    0.000
##    .bfi_agree_4       0.807    0.038   21.223    0.000
##    .bfi_agree_5       0.803    0.038   21.191    0.000
##    .bfi_agree_6r      0.529    0.029   18.037    0.000
##    .bfi_agree_7       0.792    0.038   21.112    0.000
##    .bfi_agree_8r      0.425    0.027   15.815    0.000
##    .bfi_agree_9       0.835    0.039   21.424    0.000
##    .soi_r_atttd_6r    0.326    0.023   14.380    0.000
##    .soi_r_attitd_4    0.376    0.024   16.005    0.000
##    .soi_r_attitd_5    0.326    0.023   14.359    0.000
##    .bfi_consc_2r      0.818    0.038   21.378    0.000
##    .bfi_consc_3       0.600    0.031   19.400    0.000
##    .bfi_consc_1       0.561    0.030   18.871    0.000
##    .bfi_consc_9r      0.711    0.035   20.564    0.000
##    .bfi_consc_4r      0.640    0.032   19.864    0.000
##    .bfi_consc_5       0.610    0.031   19.521    0.000
##    .bfi_consc_6       0.629    0.032   19.742    0.000
##    .bfi_consc_7       0.660    0.033   20.079    0.000
##    .bfi_consc_8r      0.676    0.033   20.238    0.000
##    .asndrpf_shyn_4    0.380    0.020   19.403    0.000
##    .asndrpf_shyn_2    0.456    0.023   20.225    0.000
##    .asndrpf_shyn_5    0.683    0.032   21.547    0.000
##    .asndrpf_shyn_3    0.340    0.018   18.794    0.000
##    .asndrpf_shyn_1    0.339    0.018   18.777    0.000
##    .bfi_neuro_2r      0.522    0.027   19.250    0.000
##    .bfi_neuro_1       0.674    0.033   20.729    0.000
##    .bfi_neuro_3       0.495    0.026   18.904    0.000
##    .bfi_neuro_4       0.667    0.032   20.673    0.000
##    .bfi_neuro_5r      0.525    0.027   19.292    0.000
##    .bfi_neuro_8       0.644    0.031   20.491    0.000
##    .bfi_neuro_6r      0.525    0.027   19.288    0.000
##    .bfi_neuro_7       0.593    0.030   20.036    0.000
##    .pvd_grm_vrsn_2    0.668    0.040   16.501    0.000
##    .pvd_grm_vrs_3R    0.704    0.040   17.415    0.000
##    .pvd_grm_vrsn_1    0.669    0.040   16.527    0.000
##    .pvd_grm_vrs_4R    0.857    0.042   20.440    0.000
##    .pvd_nfctblty_1    0.265    0.025   10.509    0.000
##    .pvd_nfctblt_3R    0.419    0.026   16.164    0.000
##    .pvd_nfctblty_2    0.412    0.026   15.948    0.000
##    .spms_partner_1    0.377    0.027   14.169    0.000
##    .spms_partner_2    0.263    0.027    9.814    0.000
##    .spms_partnr_3R    0.522    0.029   18.299    0.000
##    .spms_self_1       0.318    0.021   14.865    0.000
##    .spms_self_2       0.239    0.020   11.676    0.000
##    .spms_self_3R      0.436    0.024   18.098    0.000
##    .alternatives_1    0.469    0.027   17.285    0.000
##    .alternatives_2    0.587    0.031   19.250    0.000
##    .alternatives_3    0.720    0.035   20.662    0.000
##    .alternatives_4    0.680    0.033   20.291    0.000
##    .alternatives_5    0.611    0.031   19.546    0.000
##    .alternatives_6    0.788    0.037   21.188    0.000
##    .investment_1      0.494    0.041   12.063    0.000
##    .investment_2      0.630    0.038   16.368    0.000
##    .investment_3      0.858    0.041   20.790    0.000
##    .commitment_1      0.256    0.018   13.866    0.000
##    .commitment_2      0.338    0.020   16.622    0.000
##    .commitment_3      0.373    0.021   17.479    0.000
##    .cmmnl_strngt_1    0.427    0.028   15.273    0.000
##    .cmmnl_strng_2R    0.678    0.034   19.979    0.000
##    .cmmnl_strngt_3    0.577    0.031   18.618    0.000
##    .cmmnl_strngt_4    0.757    0.036   20.763    0.000
##    .sxl_cmmnl_st_1    0.408    0.029   14.215    0.000
##    .sxl_cmmnl_st_2    0.243    0.030    8.094    0.000
##    .sxl_cmmnl_st_3    0.839    0.039   21.544    0.000
##    .ecr_avo_1R        0.406    0.024   17.145    0.000
##    .ecr_avo_2         0.868    0.040   21.839    0.000
##    .ecr_avo_3R        0.379    0.023   16.504    0.000
##    .ecr_avo_4         0.768    0.036   21.317    0.000
##    .ecr_avo_5R        0.370    0.023   16.294    0.000
##    .ecr_avo_6         0.856    0.039   21.783    0.000
##    .ecr_anx_1         0.973    0.044   22.274    0.000
##    .ecr_anx_2         0.337    0.026   12.992    0.000
##    .ecr_anx_3         0.194    0.027    7.249    0.000
##    .ecr_anx_4R        0.908    0.041   22.032    0.000
##    .ecr_anx_5         0.961    0.043   22.234    0.000
##    .ecr_anx_6         0.660    0.032   20.537    0.000
##     narq              0.194    0.028    6.836    0.000
##     bfi_open          0.504    0.042   12.055    0.000
##     bfi_extra         0.545    0.041   13.339    0.000
##     bfi_agree         0.177    0.028    6.348    0.000
##     soi_r_attitude    0.673    0.046   14.728    0.000
##     bfi_consc         0.181    0.028    6.473    0.000
##     asndrpf_shynss    0.619    0.042   14.574    0.000
##     bfi_neuro         0.477    0.041   11.782    0.000
##     pvd_germ_avrsn    0.331    0.043    7.690    0.000
##     pvd_infectblty    0.734    0.048   15.136    0.000
##     spms_partner      0.622    0.046   13.455    0.000
##     spms_self         0.681    0.045   15.046    0.000
##     alternatives      0.530    0.043   12.321    0.000
##     investment        0.505    0.052    9.722    0.000
##     commitment        0.743    0.046   16.320    0.000
##     commnl_strngth    0.572    0.045   12.634    0.000
##     sxl_cmmnl_strn    0.591    0.046   12.728    0.000
##     ecr_avo           0.593    0.044   13.619    0.000
##     ecr_anx           0.026    0.011    2.404    0.016
lcor_llm <- cfa(model, 
            sample.cov = cors, sample.nobs = 1000)
## Warning in lav_object_post_check(object): lavaan WARNING: some estimated ov
## variances are negative
## Warning in lav_object_post_check(object): lavaan WARNING: covariance matrix of latent variables
##                 is not positive definite;
##                 use lavInspect(fit, "cov.lv") to investigate.
rels_llm <- semTools::compRelSEM(lcor_llm)
summary(lcor)
## lavaan 0.6.16 ended normally after 76 iterations
## 
##   Estimator                                         ML
##   Optimization method                           NLMINB
##   Number of model parameters                        21
## 
##   Number of observations                          1000
## 
## Model Test User Model:
##                                                       
##   Test statistic                               659.252
##   Degrees of freedom                                34
##   P-value (Chi-square)                           0.000
## 
## Parameter Estimates:
## 
##   Standard errors                             Standard
##   Information                                 Expected
##   Information saturated (h1) model          Structured
## 
## Latent Variables:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   bfi_neuro =~                                        
##     bfi_neuro_2r      1.000                           
##     bfi_neuro_1       3.887    1.049    3.704    0.000
##     bfi_neuro_3       6.322    1.673    3.778    0.000
##     bfi_neuro_4       5.136    1.368    3.756    0.000
##     bfi_neuro_8       5.852    1.552    3.771    0.000
##     bfi_neuro_6r      1.931    0.570    3.388    0.001
##     bfi_neuro_7       5.938    1.574    3.773    0.000
##   spms_self =~                                        
##     spms_self_1       1.000                           
##     spms_self_2       0.720    0.112    6.422    0.000
##     spms_self_3R      0.234    0.047    4.961    0.000
## 
## Covariances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   bfi_neuro ~~                                        
##     spms_self         0.009    0.005    1.771    0.077
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##    .bfi_neuro_2r      0.982    0.044   22.297    0.000
##    .bfi_neuro_1       0.748    0.036   21.079    0.000
##    .bfi_neuro_3       0.336    0.023   14.539    0.000
##    .bfi_neuro_4       0.561    0.029   19.331    0.000
##    .bfi_neuro_8       0.431    0.025   17.137    0.000
##    .bfi_neuro_6r      0.937    0.042   22.110    0.000
##    .bfi_neuro_7       0.414    0.025   16.749    0.000
##    .spms_self_1       0.110    0.135    0.811    0.418
##    .spms_self_2       0.538    0.074    7.251    0.000
##    .spms_self_3R      0.950    0.043   22.017    0.000
##     bfi_neuro         0.017    0.009    1.892    0.058
##     spms_self         0.889    0.142    6.251    0.000
rels <- data.frame(scale = names(rels_llm),
              rel_llm = rels_llm,
              rel_real = rels_real)

cor.test(rels_llm, rels_real)

    Pearson's product-moment correlation

data:  rels_llm and rels_real
t = 1.1522, df = 17, p-value = 0.2652
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.2108484  0.6445524
sample estimates:
      cor 
0.2691358 
lm(rels_llm ~ rels_real)
## 
## Call:
## lm(formula = rels_llm ~ rels_real)
## 
## Coefficients:
## (Intercept)    rels_real  
##      0.1909       0.5785
ggplot(mapping = aes(x = rels_llm, y = rels_real, label = names(rels_llm))) +
  geom_abline(linetype = "dashed") +
  geom_point() +
  ggrepel::geom_text_repel() +
  coord_fixed(xlim = c(0,1), ylim = c(0,1)) 
## Warning: ggrepel: 3 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

estimated_rs <- standardizedsolution(lcor_real) %>% 
  left_join(standardizedsolution(lcor_llm), by = c("lhs", "op", "rhs")) %>% 
  select(lhs, op, rhs, est.std.x, est.std.y) %>% 
  left_join(rels %>% select(scale, rel_llm_lhs = rel_llm, rel_real_lhs = rel_real), by = c("lhs" = "scale")) %>% 
  left_join(rels %>% select(scale, rel_llm_rhs = rel_llm, rel_real_rhs = rel_real), by = c("rhs" = "scale"))

lv_rs <- estimated_rs %>% filter(op == "~~", !str_detect(lhs, "[0-9]"), 
                        !str_detect(rhs, "[0-9]")) %>% 
  filter(lhs != rhs) %>% 
  mutate(est_manifest_llm = est.std.y * sqrt(rel_llm_lhs * rel_llm_rhs)) %>% 
  mutate(est_manifest_real = est.std.x * sqrt(rel_real_lhs * rel_real_rhs))


cor.test(lv_rs$est.std.x, lv_rs$est.std.y)

    Pearson's product-moment correlation

data:  lv_rs$est.std.x and lv_rs$est.std.y
t = 7.7117, df = 169, p-value = 1.019e-12
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.3899780 0.6133057
sample estimates:
      cor 
0.5101915 
cor.test(lv_rs$est_manifest_llm, lv_rs$est_manifest_real)

    Pearson's product-moment correlation

data:  lv_rs$est_manifest_llm and lv_rs$est_manifest_real
t = 8.3058, df = 169, p-value = 3.076e-14
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.4224623 0.6370034
sample estimates:
      cor 
0.5384002 
lv_rs %>% 
  filter(lhs != "ecr_avo", rhs != "ecr_avo") %>% 
  { 
    cor.test(.$est.std.x, .$est.std.y)
    }

    Pearson's product-moment correlation

data:  .$est.std.x and .$est.std.y
t = 7.58, df = 151, p-value = 3.247e-12
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.3996145 0.6311052
sample estimates:
      cor 
0.5250022 
cor.test(abs(lv_rs$est.std.x), abs(lv_rs$est.std.y))

    Pearson's product-moment correlation

data:  abs(lv_rs$est.std.x) and abs(lv_rs$est.std.y)
t = 5.9391, df = 169, p-value = 1.589e-08
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.2831235 0.5324107
sample estimates:
    cor 
0.41554 
qplot(lv_rs$est.std.y, lv_rs$est.std.x)
## Warning: `qplot()` was deprecated in ggplot2 3.4.0.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

lm(est.std.y ~ est.std.x, lv_rs)
## 
## Call:
## lm(formula = est.std.y ~ est.std.x, data = lv_rs)
## 
## Coefficients:
## (Intercept)    est.std.x  
##     0.08844      0.82108
lm(est.std.x ~ est.std.y, lv_rs)
## 
## Call:
## lm(formula = est.std.x ~ est.std.y, data = lv_rs)
## 
## Coefficients:
## (Intercept)    est.std.y  
##    -0.02107      0.31701
estimated_rs <- parameterestimates(lcor_real) %>% 
  left_join(parameterestimates(lcor_llm), by = c("lhs", "op", "rhs")) %>% 
  select(lhs, op, rhs, est.x, est.y)

lv_rs <- estimated_rs %>% filter(op == "~~", !str_detect(lhs, "[0-9]"), 
                        !str_detect(rhs, "[0-9]")) %>% 
  filter(lhs != rhs)

cor.test(lv_rs$est.x, lv_rs$est.y)

    Pearson's product-moment correlation

data:  lv_rs$est.x and lv_rs$est.y
t = 7.3131, df = 169, p-value = 9.984e-12
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.3672414 0.5964764
sample estimates:
      cor 
0.4902924 
cor.test(abs(lv_rs$est.x), abs(lv_rs$est.y))

    Pearson's product-moment correlation

data:  abs(lv_rs$est.x) and abs(lv_rs$est.y)
t = 6.0974, df = 169, p-value = 7.102e-09
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.2932581 0.5402837
sample estimates:
     cor 
0.424642 
qplot(lv_rs$est.y, lv_rs$est.x)

lv_rs %>% 
  mutate(correlation = round(est.x, 2)) %>% 
  mutate(llm_based = round(est.y, 2)) %>% 
  mutate(scales = str_c(lhs, "\n", rhs)) %>% 
ggplot(., aes(correlation, llm_based, label = scales)) + 
  geom_abline(linetype = "dashed") +
  geom_point() +
  coord_fixed(xlim = c(-1,1), ylim = c(-1,1)) -> p

ggplotly(p)